perm filename MUS1.F4[P11,LCS] blob
sn#583810 filedate 1981-05-02 generic text, type T, neo UTF8
C*** MUS1.F4 ****
C*** STAFF, KSIG, METER, MAKNUM ********
SUBROUTINE STAFF
COMMON R2,JA,CENTR,J2,R3,R4,R5,R6,R7,R8,RJQ(10),X,RX,RJ,RZ
1,JQ(16),J,JX2,K,L
COMMON/STF/RSTFAC(0/7)/POSI/STFF(0/7),JJ2,POS/PLTR/PLT
EQUIVALENCE (J4,JQ(2)),(J7,JQ(5))
C FOR STAFF LINES: 8, POS 1, HGT(0 TO 7), UP-DOWN(NT #S),
C P5=SIZE, P6=2ND POS., P7=(1=INVIS.), P8=SPACER, P9=INST. NAME
C P6=SIZE FACTOR, IF P7↑[0 STAFF IS INVIS. P4=1000=ONE LINE, 2000=2 LINES.
C PLT =-2 MAKES HEAVY STAFF.(FOR XGP) **** not now used 4/81 ***
IF(R5.NE.0)GO TO 10
R5=RSTFAC(J2)
C GET OLD STAFF SIZE IF R5 IS 0
GO TO 11
10 RSTFAC(J2)=R5
C SETS NEW STAFF SIZE
11 X=R4
L=5
IF(IABS(J4).LT.1000)GO TO 12
X=AMOD(R4,1000.)
L=IABS(J4/1000)
C 1000'S FOR N LINE STF. P4=0=STANDARD 5-LINE STAFF. 6000=6 LINES, ETC.
12 J=J2*123-469
RX=J+X*7.*R5
C NOW STAFF NUMS RUN FROM 0 TO 7
STFF(J2)=RX
C SAVE ABSOLUTE POSITION OF STAFF.
RX=RX+3.*R5
IF(R6.EQ.0)GO TO 7
RJ=RHORZ(R6)
GO TO 8
7 RJ=596.
8 R5=R5*14.
C R5 NOW HAS SPACE BETWEEN LINES IN PIXELS.
IF(R8.EQ.0)GO TO 68
IF(PLT.LT.0)GO TO 68
RZ=RX+R8*167.
C 167 IS A MAGIC NUMBER!! PUTS LINE ON DPY. R8 IS IN INCHES
CALL LINX(R3,RZ,RJ,RZ)
C SHOWS WHERE NEXT STAFF 0 WILL BE.
68 IF(J7.EQ.0)GO TO 101
C FOR INVISIBLE STAFF
IF(PLT.EQ.0)CALL LINES(-596.,RX,3)
C TO ACTIVATE DPY BUFFER
RETURN
101 DO 6 K=1,L
CALL LINX(R3,RX,RJ,RX)
6 RX=RX+R5
C R5 HAS SPACE (IN PIXELS) BETWEEN EACH LINE.
C SEE .FAI PROG. FOR METHOD WHEN OUTPUTTING TO A PEN PLOTTER.
END
SUBROUTINE KSIG
COMMON R2,JA,CENTR,J2,RJQ(20),JQ(17),T,Z,H/STF/RSTFAC(-3/4),RSTJ2
C******************;;;; Z WIPED OUT IN NOTWRT!!! BE CAREFUL WITH S!!!
EQUIVALENCE (R4,RJQ(2)),(J4,JQ(2)),(J5,JQ(3)),(J6,JQ(4))
1,(R6,RJQ(4)),(R3,RJQ(1))
JA=9
C USES THIS KEY NUM IN NOTWRT
IZ=IABS(J5)
C NUMBER OF CALLS ON NOTWRT
C THE CLEF NUM. IT GETS WIPED OUT IN NOTWRT.
JW=1
R6=0
IF(J5.GT.0)JW=2
C THE CODE FOR FLAT OR SHARP
IF(IZ.LT.100)GO TO 5333
JW=3
IZ=IZ-100
C WILL MAKE NATURALS IF 100 IS ADDED OR SUBTRACTED.
5333 CLEF=J6
CLEF #S ARE 0,1,2,3 (TREB.,BA.,ALT.,TEN.)
C CLEF NOW SET IN MAIN PROG. IF NO CLEF GIVEN, TREBLE IS USED.
IF(J6.LT.100)GO TO 53
R6=.8
CLEF=CLEF-100.
53 T=10.
C MINIS
IF(CLEF.GT.1.)T=11.
S=3.-CLEF
IF(S.EQ.0)S=-1.
IF(J5.LT.0)GO TO 253
W=-3.
YY=4.
Z=11.
C SHARPS
GO TO 353
253 W=-4
YY=3.
Z=7.
C FLATS
353 N=-1
Z=Z+R4
RX=R3
RA=0
C RA IS AMOUNT TO BE ADDED TO ORIGINAL POS.
WW=RSTJ2*13.
IF(R6.NE.0)WW=WW*R6
RD6=R6
DO 553 KA=1,IZ
J5=JW
R3=RX+RA
RA=RA+WW
C MOVES OVER FOR NEXT ACCI.
R6=RD6
C SIZE - R6 GETS WIPED OUT IN NOTWRT
RD=Z
R4=Z
IF(CLEF.NE.0)GO TO 7
IF(R4.GT.12.)R4=R4-7.
GO TO 9
7 R4=R4-S
IF(R4.GT.T)R4=R4-7.
C ABOVE ARRANGES VERT. POS OF ACCIS.
9 J4=R4
C FOR VERT. POS. IN 'DRWNT' (WHEN PLOTTING.)
CALL CENTX
CALL NOTWRT
Z=RD+W
IF(N.LT.0)Z=RD+YY
C N WAS -1 1ST TIME.
553 N=-N
END
SUBROUTINE METER
COMMON R2,JA,CENTR,J2,RJQ(20),JQ(17),T,Z,H/STF/RSTFAC(8),RSTJ2
1 /POSI/STFF(0/7),JJ2,POS
EQUIVALENCE (R4,RJQ(2)),(J4,JQ(2)),(J5,JQ(3)),(J6,JQ(4))
1,(R6,RJQ(4)),(R5,RJQ(3)),(R3,RJQ(1)),(R7,RJQ(5)),
1 (R8,RJQ(6)),(R10,RJQ(8)),(R11,RJQ(9)),(R9,RJQ(7))
1,(RX3,RJQ(20)),(J3,JQ(1))
IF(R7.NE.0)GO TO 10
R7=1.25
GO TO 11
10 R7=R7*1.25
11 R4=R4-2.21
KS=0
C FLAG FOR DOUBLE METERS 3/4+5/8 ETC.
IF(R8.EQ.0)GO TO 1
RD8=R8
C SAVE VARIOUS PARAMETERS
R8=0
RD7=R7
C SIZE
RD3=R3
CENTD=CENTR
KS=-1
C SET DOUBLE METER FLAG
RD4=R4
POSP=12.
C POS FOR PLUS SIGN
POSM=19.
C POS FOR 2ND METER
IF(J6.LT.10)GO TO 6
C INCREASE SPACE FOR DOUBLE DIGIT NUMBERS
POSP=17.
POSM=24.
6 IF(R10.EQ.0)R10=1
IF(R11.EQ.0)R11=R10
C R10 MOVES +, R11 MOVES 2ND METER
POSP=POSP*R10
C P10, P11 CAN CHANGE SPREAD BETWEEN METERS
POSM=POSM*R11
R11=0
C R11 MUST =0 FOR OTHER PLACES
1 JZ=J3
IF(R5.NE.0)GO TO 102
C MOVEM 02,JZ# ; 25300 RY=R4+8.*.COMM.+=8
R7=R7+.25
C INCREASE SIZE(1.25) FOR SINGLE METER.
R4=R4+.94
102 R4=R4+R7*8.
C ADD 8 TO RAISE IT
RY=R4
C HEIGHT
RW=R6
C BOTTOM NUM
R6=R7
RR6=R6
C SIZE FOR BDR40 -- OR =1
M=0
2 R7=0
IF(R5.EQ.0)GO TO 103
IF(R5.LT.90.)GO TO 3
M=-1
C IF TOP NUM.=0 SKIP OVER
C 99 AS METER = 'C' 98=ALLA BREVE (CUT TIME)
IF(R5.NE.98)GO TO 4
C NEXT FOR LINE THROUGH C.
RA=POS
R6=RX3
C TO LINE UP WITH R3
J10=2
C FOR THICK LINE
R4=R4-3.8
R5=R4+5.6
J7=0
R8=0
CALL ITMSUB
POS=RA
R4=RY
R6=RR6
C GET BACK THE RIGHT PARAMS.
4 R5=9999.
C TO CENTER 12S AND 16S
3 CALL MAKNUM(R5)
IF(M.LT.0)GO TO 5
103 M=-1
C STICK AROUND FOR BOTTOM NUM
R6=RR6
R4=RY+.9-4.*RR6
R5=RW
C GET BOTTOM NUM
J3=JZ
R8=0
IF(R5.GT.0)GO TO 2
5 IF(KS.EQ.0)RETURN
C SKIP IF DOUBLE METER
KS=0
R4=RD4+4.
C GET BACK VERT POS.
C ADD FOR + SIGN
RX=R9
R6=RD7
C SIZE
R7=RD7
R9=0
R8=0
JA=9
J5=14
RJ=RSTJ2*RD7
CENTR=CENTD+36.*RJ
JZ=JZ+POSM*RJ
J3=JZ
R3=RD3+POSP*RJ
C MOVE TO RIGHT 25 BASIC NOTCHES
C SHIFT + 10 NOTCHES TO RIGHT OF ORIG.
CALL NOTWRT
R4=RD4
C GET BACK BASIC R4
C PUT RD8 AND RX INTO R5 AND R6
R5=RD8
R6=RX
R7=RD7
C GET BACK SIZE
X=20.
C SHIFT MORE TO RIGHT
C ADD MORE SPACE IF BOT. # >10
IF(RX.GE.10.)X=25.
JZ=JZ+X*RJ
J3=JZ
C NEW POS IN J3
GO TO 1
END
SUBROUTINE MAKNUM(RNUM)
COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
1 /STF/RSTFAC(8),RSTJ2
1 /NFONT/NFONT
C*** PUT THIS IN AFTER ALPHA IS TRANSLATED
EQUIVALENCE (J3,JQ(1)),(R4,RJQ(2)),(R8,RJQ(6)),(R7,RJQ(5))
1,(R6,RJQ(4)),(R5,RJQ(3)),(R7,RJQ(5)),(JQ(15),B),(JQ(16),C)
1 ,(J8,JQ(6)),(J10,JQ(8)),(R3,RJQ(1)),(J5,JQ(3)),(RJY,JQ(19))
1 ,(J7,JQ(5)),(J6,JQ(4)),(R9,RJQ(7))
DATA RS/10.0/,RBX/1.0/
RB8=R8
J3X=J3
C P7=0=BDR40; =1=BDI40; =2=PRIM.
IF(R6.GE.100.)R6=R6-100.
IF(R6.EQ.0)R6=1.
R5=R6
C IF R6 > 100 IT'S FOR THE PAGE PROG. SUBTRACT 100 TO GET TRUE SIZE
C IF IT'S 0 MAKE INTO 1.0 UPPER CASE - BDR40
IF(R7.GT.2.)R7=0
R6=48000000.0+(R7+50.)*10000.
R7=99999999.0
C BLANKS
ONE=0
IF(RNUM.NE.9999.)GO TO 2
C NEXT FOR 'C'OMMON TIME
RNUM=12.
C MAKES A 'C'
R4=R4-2.2
C .2 FOR BAD POS. OF LETTERS
GO TO 4
2 RNUM=IFIX(RNUM)
C SO MISTAKES (I.E. 2.2) WON'T BREAK THE PROG.
IF(RNUM.EQ.1.)ONE=3.
IF(RNUM.GT.9.)GO TO 3
C JUMP FOR 2 OR 3 DIGIT NUMBER
4 R6=R6+RNUM*100.+47.
C PUTS BLANK ON END (.47)
GO TO 1
3 RJY=10.
IF(RNUM.GE.100.)RJY=100.
B=IFIX(RNUM/RJY)
C=AMOD(RNUM,RJY)
IF(RNUM.LT.100)GO TO 7
D=IFIX(C/10.)
C=AMOD(C,10.)
IF(C.EQ.1.)ONE=ONE+3.
R7=C*1000000.+999999.0
C=D
7 R6=R6+B*100.+C
IF(B.EQ.1.)ONE=ONE+3.
IF(C.EQ.1.)ONE=ONE+3.
B=R5
IF(RNUM.GE.100.)B=B*2
J3=J3-RS*RSTJ2*B
C FOR 2 DIGIT NUMBER ADJUSTS FOR 11, ETC.
1 J3=J3+ONE*R5*RSTJ2
C CENTERS THE NUMBER '1'
MFONT=NFONT
CALL ALPHA
NFONT=MFONT
C RESTORE FONT TO WHATEVER IT WAS BEFORE
J3=J3X
IF(RB8.EQ.0)RETURN
C NEXT FOR CIRCLES AND BOXES AROUND NUMBERS.
R3=J3-R5
IF(J10.EQ.0)J10=1
C USE J10 FOR EVEN THICKER BOX AND CIRC.
IF(RNUM.GT.9)R3=R3+R5*RBX
C TO SET CENTER
IF(RB8.EQ.2.)GO TO 5
R4=R4+R5+.1+.05/R5
C END OF ABOVE IS FOR SMALL CIRCLES.
B=4.5
IF(RNUM.GE.100.)B=5.5
R5=R5*B
J6=0
J7=0
J8=J10
CALL CENTX
CALL CIRCLE
RETURN
5 B=6.
R9=0
IF(RNUM.LT.100.)GO TO 8
B=9.
R9=R5*6.
C MAKES RECTANGLE IF >=100
8 R4=R4+R5*.7+.1
R8=R5*B
J5=50
R3=R3+1.0
C SHIFT BOX SLIGHTLY TO RIGHT
CALL ITMSUB
END